home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / oppopwin.zip / OPPOPWIN.PAS < prev    next >
Pascal/Delphi Source File  |  1992-03-31  |  31KB  |  868 lines
  1. Unit OpPopWin;
  2. {$I OPDEFINE.INC}
  3.  
  4. { ***************************************************************************
  5.  *                                                                          *
  6.  *                      POPWINDOW Version 1.0                               *
  7.  *                      Dated  : 03/06/92                                   *
  8.  *                      Author : Hans Otten                                 *
  9.  *                                                                          *
  10.  *          The latest version, allong with the author, can always          *
  11.  *          be found at the LONDON PC USERS GROUP BBS (519-472-9471)        *
  12.  *                                                                          *
  13.  ************************************************************************** }
  14.  
  15. Interface
  16. Uses OpCrt,
  17.      OpRoot,
  18. {$IFDEF UseMouse}
  19.      OpMouse,
  20. {$ENDIF}
  21.      OpCmd,
  22.      OpFrame,
  23.      OpWindow,
  24.      OpString,
  25.      OpKey,
  26.      OpInline;
  27.  
  28.  
  29.  
  30.  
  31. Const
  32.      KeyMax      = 120;          { Maximum # of keys in keyset }
  33.      MaxNumPicks =  20;          { Maximum number of selections in one menu }
  34.      MaxTopicLen =  80;          { Maximum length of each topic }
  35.      ccScrollWin = ccUser50;     { Command to allow window to move }
  36.  
  37.      ppStick       = $0001;      { Stick on menu selections. }
  38.      ppCapitalize  = $0002;      { Capitalize the current highlighted menu choice }
  39.      ppUseLetters  = $0004;      { Use letters as selection choice, else use numbers }
  40.      ppAllowEsc    = $0008;      { Allow the user to exit the menu by pressing ESC }
  41.  
  42.      DefPopWindowOptions = 0;    { Default window options }
  43.  
  44.      Ident : String[15] = 'Popwin Key Set';
  45.      KeySet : Array[0..KeyMax] of Byte = (
  46.               { Length   Keys           Command Type   Key sequence }
  47.                 3,       $00, $48,      ccUp,          { Up arrow }
  48.                 3,       $00, $50,      ccDown,        { Down Arrow }
  49.                 3,       $00, $4B,      ccLeft,        { Left Arrow }
  50.                 3,       $00, $4D,      ccRight,       { Right Arrow }
  51.                 3,       $00, $47,      ccHome,        { Home }
  52.                 3,       $00, $49,      ccPageUp,      { PgUp }
  53.                 3,       $00, $4F,      ccEnd,         { End }
  54.                 3,       $00, $51,      ccPageDn,      { PgDn }
  55.                 3,       $00, $52,      ccIns,         { Ins }
  56.                 3,       $00, $53,      ccDel,         { Del }
  57.                 2,       $09,           ccTab,         { Tab }
  58.                 2,       $0D,           ccSelect,      { Enter }
  59.                 2,       $1B,           ccQuit,
  60.                 3,       $00, $3B,      ccHelp,         {F1}
  61.                 3,       $00, $3F,      ccScrollWin,   {Scroll lock}
  62. {$IFDEF UseMouse}
  63.                 3,       $00, $EF,      ccMouseSel,     {click left  = mouse select}
  64. {$ELSE}
  65.                 0,         0,   0,             0,
  66. {$ENDIF}
  67.                      0,0,0,0,0,0,0,0,0,0,              {70}
  68.                      0,0,0,0,0,0,0,0,0,0,              {80}
  69.                      0,0,0,0,0,0,0,0,0,0,              {90}
  70.                      0,0,0,0,0,0,0,0,0,0,              {100}
  71.                      0,0,0,0,0,0,0,0,0,0,              {110}
  72.                      0,0,0,0,0,0,0,0,0,0);             {120}
  73.  
  74.      CfgEnd : Byte = 0;
  75.  
  76.      AllowSet : Array[1..2] of Set of Char =
  77.                 (['1','2','3','4','5','6','7','8','9'],
  78.                  ['A'..'Z']);
  79.  
  80.      PopWindowFrame : FrameArray = '▀'+' '+'▀'+' '+
  81.                                    '▀'+' '+' '+' ';
  82.  
  83. Type
  84.     TopicRec  = Record        { Record of each topic }
  85.                       Name     : String[MaxTopicLen];
  86.                       Selected : Boolean;
  87.                       Id       : Byte;
  88.                 End;
  89.     PopWindowPtr = ^PopWindow;
  90.     PopWindow =
  91.                Object(CommandWindow)
  92.                      Options : Word;         {Global options }
  93.                      XTop,                   { Menu coordinates }
  94.                      YTop,
  95.                      XBottom,
  96.                      YBottom  : Byte;
  97.                      Header1,                { Top header # 1 }
  98.                      Header2  : String[40];  { Top Header # 2 }
  99.                      TextColor,              { Color of normal text }
  100.                      TextMono,               { Mono color of normal text }
  101.                      HeaderColor,            { Color of header text }
  102.                      HeaderMono,             { Mono color of header text }
  103.                      FrameColor,             { Color of outside frame }
  104.                      FrameMono,              { Mono color of outside frame }
  105.                      ChoiceColor,            { Color of current choice }
  106.                      ChoiceMono,             { mono color of current choice }
  107.                      HighLightColor,         { Color of highlight option }
  108.                      HighLightMono : Byte;   { Mono color of highlight option }
  109.                      DefaultSet    : Byte;   { 1 = Number's 1 thru 9, 2 = A .. T }
  110.                      Headers       : Byte;   { Number of headers in use }
  111.                      Choice        : Byte;   { The current highlighted choice }
  112.                      MaxPicks      : Byte;   { Number of topics in menu }
  113.                      Topics        : Array[1..MaxNumPicks] of TopicRec;{ Menu record }
  114.                      PadLen        : Byte;   { Size of left margin (minimun = 3) }
  115.                      Selector      : Char;   { The selector character in left margin }
  116.  
  117.                   
  118.  
  119.                   Function GetTopicNum(TopicId : Byte) : Byte;
  120.                   {Get the physical location in the array based on topic ID }
  121.  
  122.                   Function GetTopicId(TopicNum : Byte) : Byte;
  123.                   { Get the Id of the physical location TOPICNUM in the array }
  124.  
  125.                   Constructor Init(X1, Y1, X2, Y2:Byte; NumHeaders : Byte; Var Colors : ColorSet);
  126.                   { The constructor to initialize the object }
  127.  
  128.                   Function AdjustMenu : Boolean;
  129.                   { This procedure will grow, or shrink, the menu (INTERNAL) }
  130.  
  131.                   Procedure AddHeaders(H1,H2 : String);
  132.                   { Add headers to the menu }
  133.  
  134.                   Procedure AddTopic(TopicName : String; TopicId : Byte);
  135.                   { Add a new menu topic }
  136.  
  137.                   Procedure SetDefaultChoice(TopicId : Byte);
  138.                   { Set the default choice to start on }
  139.  
  140.                   Function GetLastChoice : Byte;
  141.                   { Return the last selection by user, returns the choice ID}
  142.  
  143.                   Function GetMaxChoices : Byte;
  144.                   { Return total number of entries in menu }
  145.  
  146.                   Procedure GetCoordinates(Var X1, Y1, X2, Y2 : Byte);
  147.                   { Get the coordinates of the menu }
  148.  
  149.                   Procedure SetPadLength(Len : Byte);
  150.                   { Set the length of the left margin }
  151.  
  152.                   Procedure SetSelectorChar(CH : Char);
  153.                   { Set the selector character }
  154.  
  155.                   Function ppOptionsAreOn(SelOptions : Word) : Boolean;
  156.                   { Determine what options are turned on }
  157.  
  158.                   Procedure ppOptionsOn(SelOptions : Word);
  159.                   { Turn selected option(s) on }
  160.  
  161.                   Procedure ppOptionsOff(SelOptions : Word);
  162.                   { Turn selected option(s) off }
  163.  
  164.                   Procedure ScrollWindow(XT,YT,XB,YB : Byte);
  165.                   { Move the menu to another location, within the defined boundaries }
  166.  
  167.                   Procedure Redraw(LNum : Byte);
  168.                   { Redraw a menu option (internal) }
  169.  
  170.                   Procedure ChangeTopic(TopicNum : Byte; NewTopic : String; RedrawMenu : Boolean);
  171.                   { Change the topic entry }
  172.  
  173.                   Procedure RemoveTopic(TopicNum : Byte; MoveRemaining : Boolean);
  174.                   { Remove a topic and redraw the screen }
  175.  
  176.                   Procedure SwitchTopics(Topic1, Topic2 : Byte);
  177.                   { Procedure swith the topic entries for 2 topics }
  178.  
  179.                   Procedure Draw; Virtual;
  180.                   { Draw the menu }
  181.  
  182.                   Procedure Process; Virtual;
  183.                   { Process the menu commands }
  184.  
  185.                End;
  186.  
  187. Var
  188.    PopCommands : CommandProcessor;
  189.  
  190.  
  191. Implementation
  192.  
  193. Function PopWindow.GetTopicNum(TopicId : Byte) : Byte;
  194. { ***************************************************************************
  195.   Get the phisical location of a topic Id in the array, Returns 0 if TopicID
  196.   not found, else the location number.
  197. *************************************************************************** }
  198.  
  199.  
  200. Var i : Integer;
  201.     Found : Boolean;
  202.  
  203. Begin
  204.      i := 1;
  205.      Found := False;
  206.      While (i <= MaxPicks) and (Not Found) do
  207.      Begin
  208.           If (Topics[i].ID = TopicId) then
  209.              Found := True
  210.           Else
  211.              Inc(i);
  212.      End;
  213.      If Found then
  214.         GetTopicNum := i
  215.      Else
  216.         GetTopicNum := 0;
  217. End;
  218.  
  219.  
  220. Function PopWindow.GetTopicId(TopicNum : Byte) : Byte;
  221. { ***************************************************************************
  222.    Get the Id of the physical location TOPICNUM in the array.
  223. *************************************************************************** }
  224.  
  225.  
  226. Begin
  227.      If (TopicNum > 0) and (TopicNum <= MaxPicks) then
  228.         GetTopicId := Topics[TopicNum].Id
  229.      Else
  230.         GetTopicId := 0;
  231. End;
  232.  
  233.  
  234. Constructor PopWindow.Init(X1, Y1, X2, Y2:Byte; NumHeaders : Byte; Var Colors : ColorSet);
  235. { ***************************************************************************
  236.    Initialize the Pop up menu
  237. *************************************************************************** }
  238.  
  239. Begin
  240.      Headers := NumHeaders;
  241.      If Headers > 2 then     { No more than two headers can be initialized at once }
  242.         Headers := 2;
  243.      If Headers < 0 then
  244.         Headers := 0;
  245.  
  246.      { Initialize the command window }
  247.  
  248.      If Not CommandWindow.InitCustom( X1, Y1+Headers, X2, Y2,     { Window Coordinates }
  249.                                       Colors,
  250.                                       wBordered+WClear+WSaveContents,
  251.                                       PopCommands,
  252.                                       ucNone) then Fail;
  253.  
  254.      { Set the frame type and add a span header if there are any headers }
  255.  
  256.      WFrame.SetFrameType(PopWindowFrame);
  257.      AdjustFrameCoords(X1-1,Y1-1-Headers,X2+1,Y2+1);
  258.      If (NumHeaders > 0) then
  259.         WFrame.AddSpanHeader('─','─','─',1+Headers,frTT);
  260.  
  261.      { Read the appropriate values from colors into the object }
  262.  
  263.      TextColor     := Colors.TextColor;
  264.      TextMono      := Colors.TextMono;
  265.      HeaderColor   := Colors.PromptColor;
  266.      HeaderMono    := Colors.PromptMono;
  267.      FrameColor    := Colors.FrameColor;
  268.      FrameMono     := Colors.FrameMono;
  269.      ChoiceColor   := Colors.HighItemColor;
  270.      ChoiceMono    := Colors.HighItemMono;
  271.      HighLightColor:= Colors.HighLightColor;
  272.      HighLightMono := Colors.HighLightMono;
  273.  
  274.      { Read the coordinates in }
  275.  
  276.      XTop          := X1;
  277.      XBottom       := X2;
  278.      YTop          := Y1+Headers;
  279.      YBottom       := Y2;
  280.      MaxPicks      := 0;
  281.      Options       := DefPopWindowOptions;
  282.  
  283.      { Set default startup values }
  284.  
  285.      FillChar(Topics,SizeOf(Topics),0);
  286.      PadLen        := 5;
  287.      Selector      := #16;
  288.      Choice        := 1;
  289.      DefaultSet    := 2;
  290. End;
  291.  
  292. Procedure PopWindow.AddHeaders(H1,H2 : String);
  293. { ***************************************************************************
  294.    Add the header strings to the menu
  295. *************************************************************************** }
  296.  
  297.  
  298. Begin
  299.      Header1 := H1;
  300.      Header2 := H2;
  301. End;
  302.  
  303. Function PopWindow.GetLastChoice : Byte;
  304. { ***************************************************************************
  305.    Return the last selected choice by the user
  306. *************************************************************************** }
  307.  
  308.  
  309. Begin
  310.      GetLastChoice := Topics[Choice].Id;
  311. End;
  312.  
  313. Function PopWindow.GetMaxChoices : Byte;
  314. { ***************************************************************************
  315.    Return the total number of entries into PopWindow
  316. *************************************************************************** }
  317.  
  318.  
  319. Begin
  320.      GetMaxChoices := MaxPicks;
  321. End;
  322.  
  323. Procedure PopWindow.GetCoordinates(Var X1, Y1, X2, Y2 : Byte);
  324. { ***************************************************************************
  325.    Return the coordinates of the window (Not the frame)
  326. *************************************************************************** }
  327.  
  328. Begin
  329.      X1 := XTop;
  330.      Y1 := YTop;
  331.      X2 := XBottom;
  332.      Y2 := YBottom;
  333. End;
  334.  
  335. Procedure PopWindow.SetPadLength(Len : Byte);
  336. { ***************************************************************************
  337.    Set the number of spaces to pad the beginning of each menu item. The
  338.    minimum setting is 4.  If entries already exist then the menu will be
  339.    redrawn.
  340. *************************************************************************** }
  341. Var
  342.    i : Byte;
  343.  
  344. Begin
  345.      If Len < 4 then
  346.         PadLen := 4
  347.      Else
  348.         PadLen := Len;
  349.      If (MaxPicks > 0) then  { Already have entries }
  350.      Begin
  351.           For i := 1 to MaxPicks do
  352.               ChangeTopic(i,Copy(Topics[i].Name,Pos('.',Topics[i].Name)+2,
  353.                             Length(Topics[i].Name)-Pos('.',Topics[i].Name)+2),False);
  354.           If AdjustMenu then
  355.           Begin
  356.           End;
  357.           If IsCurrent then
  358.              Draw;
  359.      End;
  360. End;
  361.  
  362. Procedure PopWindow.SetSelectorChar(CH : Char);
  363. { ***************************************************************************
  364.    Set the character used when the highlight bar is on
  365. *************************************************************************** }
  366. Begin
  367.      Selector := Ch;
  368.      If (MaxPicks > 0) then { Entries already exist, so change current one }
  369.         Redraw(Choice);
  370. End;
  371.  
  372. Function PopWindow.AdjustMenu : Boolean;
  373. { ***************************************************************************
  374.    This internal procedure attempts to redraw the menu in order to make it
  375.    as tight as possible.  If the function returns True, then some form of the
  376.    menu has been altered.
  377. *************************************************************************** }
  378.  
  379. Var
  380.    Wid,         { Calculated width's and hieghts }
  381.    Hig    : Byte;
  382.    Changed : Boolean;
  383.  
  384. Procedure AdjustEntries;
  385. { This procedure checks to see if Default set has enough entries to accomidate
  386.   the picks,  if it doesn't, then change defaultset and rewrite entries }
  387. Var
  388.    i : Byte;
  389.  
  390. Begin
  391.      If (MaxPicks > 9) and (DefaultSet = 1) then { Change to Letter set }
  392.      Begin
  393.           DefaultSet := 2;
  394.           ppOptionsOn(ppUseLetters);
  395.           Changed := True;
  396.           For i := 1 to MaxPicks do
  397.               ChangeTopic(i,Copy(Topics[i].Name,Pos('.',Topics[i].Name)+2,
  398.                             Length(Topics[i].Name)-Pos('.',Topics[i].Name)+2),False);
  399.      End;
  400. End;
  401.  
  402. Procedure GetWidth;
  403. Var i : Byte;
  404.  
  405. Begin
  406.      Wid := 0;
  407.      For i := 1 to MaxPicks do
  408.      Begin
  409.           If (Length(Topics[i].Name) > Wid) then
  410.              Wid := Length(Topics[i].Name);
  411.      end;
  412. End;
  413.  
  414. Procedure GetHieght;
  415. Var i : Byte;
  416.  
  417. Begin
  418.      Hig := MaxPicks;
  419. End;
  420.  
  421. Begin
  422.      Changed := False;
  423.      AdjustEntries;
  424.      GetWidth;
  425.      GetHieght;
  426.      If ( Wid > (XBottom-XTop)) then
  427.      Begin
  428.           If ((XTop+Wid) <= ScreenWidth) then
  429.           Begin
  430.                XBottom := XTop + Wid;
  431.                AdjustWindow(XTop,YTop,XBottom,YBottom);
  432.                Changed := True;
  433.           End;
  434.      End;
  435.      If (Hig > (YBottom - YTop+1)) then
  436.      Begin
  437.           If ((YTop+Hig) <= ScreenHeight) then
  438.           Begin
  439.                YBottom := YTop + Hig;
  440.                AdjustWindow(XTop,YTop,XBottom,YBottom);
  441.                Changed := True;
  442.           End;
  443.      End;
  444.      AdjustMenu := Changed;
  445. End;
  446.  
  447. Procedure PopWindow.AddTopic(TopicName : String; TopicID : Byte);
  448. { ***************************************************************************
  449.   This procedure adds a new topic to the menu,  If the menu already exists,
  450.   then the window is redrawn
  451. *************************************************************************** }
  452.  
  453. Function GetValue : Char;
  454. Begin
  455.      If (DefaultSet = 1) and (MaxPicks < 9) then
  456.         GetValue := Char(Ord('1')-1+MaxPicks)
  457.      Else
  458.         GetValue := Char(Ord('A')-1+MaxPicks);
  459. End;
  460.  
  461. Begin
  462.      If ppOptionsAreOn(ppUseLetters) then
  463.         DefaultSet := 2
  464.      Else
  465.         DefaultSet := 1;
  466.  
  467.      If ((MaxPicks + 1) <= MaxNumPicks) then
  468.      Begin
  469.           Inc(MaxPicks);
  470.           Topics[MaxPicks].Name := Pad('',PadLen-3)+GetValue+'. '+
  471.                                    Pad(TopicName,XBottom-Xtop-PadLen);
  472.           If MaxPicks = Choice then
  473.              Topics[MaxPicks].Selected := True
  474.           Else
  475.              Topics[MaxPicks].Selected := False;
  476.           Topics[MaxPicks].ID := TopicId;
  477.      End;
  478.      If AdjustMenu and IsCurrent then
  479.         Draw;
  480. End;
  481.  
  482.  
  483. Procedure PopWindow.SetDefaultChoice(TopicId : Byte);
  484. { ***************************************************************************
  485.   Set the start up choice.
  486. *************************************************************************** }
  487. Var Sel : Byte;
  488.  
  489. Begin
  490.      Sel := GetTopicNum(TopicId);
  491.      If (Sel <= MaxPicks) and (Sel > 0) then
  492.      Begin
  493.         Topics[Choice].Selected := False;
  494.         Choice := Sel;
  495.         Topics[Choice].Selected := True;
  496.      End;
  497. End;
  498.  
  499. Function PopWindow.ppOptionsAreOn(SelOptions : Word) : Boolean;
  500. { ***************************************************************************
  501.    Determine which options have been turned on
  502. *************************************************************************** }
  503.  
  504. Begin
  505.      ppOptionsAreOn := FlagIsSet(Options,SelOptions);
  506. End;
  507.  
  508. Procedure PopWindow.ppOptionsOn(SelOptions : Word);
  509. { ***************************************************************************
  510.    Turn certain options on
  511. *************************************************************************** }
  512.  
  513. Begin
  514.      SetFlag(Options,SelOptions);
  515. End;
  516.  
  517. Procedure PopWindow.ppOptionsOff(SelOptions : Word);
  518. { ***************************************************************************
  519.   Turn certain options off
  520. *************************************************************************** }
  521.  
  522. Begin
  523.      ClearFlag(Options,SelOptions);
  524. End;
  525.  
  526.  
  527. Procedure PopWindow.Redraw(LNum : Byte);
  528. { ***************************************************************************
  529.    Write one menu option (LNum) to the screen  (Internal)
  530. *************************************************************************** }
  531. Var TChar : Char;
  532.  
  533. Begin
  534.      If (LNum <= MaxPicks) then
  535.      Begin
  536.           With Topics[LNum] do
  537.           Begin
  538.                If Selected then
  539.                Begin
  540.                     MoveFast(Selector,Name[2],1);
  541.                     If ppOptionsAreOn(ppCapitalize) then
  542.                        wFastWrite(StUpCase(Name),LNum,1,ColorMono(HighLightColor,HighLightMono))
  543.                     Else
  544.                        wFastWrite(Name,LNum,1,ColorMono(HighLightColor,HighLightMono));
  545.                End
  546.                Else
  547.                Begin
  548.                     TChar := ' ';
  549.                     MoveFast(TChar,Name[2],1);
  550.                     wFastWrite(Name,LNum,1,ColorMono(TextColor,TextMono));
  551.                     wChangeAttribute(3,LNum,PadLen-3,ColorMono(ChoiceColor,ChoiceMono));
  552.                End;
  553.           End;
  554.      End;
  555. End;
  556.  
  557. Procedure PopWindow.ChangeTopic(TopicNum : Byte; NewTopic : String; RedrawMenu : Boolean);
  558. { ***************************************************************************
  559.     Change the name of a topic to NewTopic.
  560. *************************************************************************** }
  561.  
  562. Function GetValue : Char;
  563. Begin
  564.      If (DefaultSet = 1) and (MaxPicks < 9) then
  565.         GetValue := Char(Ord('1')-1+TopicNum)
  566.      Else
  567.         GetValue := Char(Ord('A')-1+TopicNum);
  568. End;
  569.  
  570. Begin
  571.      If (TopicNum <= MaxPicks) and (TopicNum > 0) then
  572.      Begin
  573.           If ppOptionsAreOn(ppUseLetters) then
  574.              DefaultSet := 2
  575.           Else
  576.              DefaultSet := 1;
  577.  
  578.           Topics[TopicNum].Name := Pad('',PadLen-3)+GetValue+'. '+
  579.                                    Pad(NewTopic,XBottom-Xtop-PadLen);
  580.           If RedrawMenu and IsCurrent then
  581.           Begin
  582.                If AdjustMenu then
  583.                Begin
  584.                End;
  585.                ActivateWrite;
  586.                Redraw(TopicNum);
  587.                DeActivateWrite;
  588.           End;
  589.      End;
  590. End;
  591.  
  592. Procedure PopWindow.RemoveTopic(TopicNum : Byte; MoveRemaining : Boolean);
  593. { ***************************************************************************
  594.     This procedure removes a particular topic from the menu.  MoveRemaining
  595.     will shift all remaining topics up one space and compress the menu.
  596. *************************************************************************** }
  597. Var i : Integer;
  598.     WasSelected : Boolean;
  599.  
  600. Begin
  601.      If (TopicNum <= MaxPicks) and (TopicNum > 0) then
  602.      Begin
  603.           WasSelected := Topics[TopicNum].Selected;
  604.           FillChar(Topics[TopicNum],SizeOf(Topics[TopicNum]),0);
  605.           If MoveRemaining then
  606.           Begin
  607.                For i := (TopicNum + 1) to MaxPicks do
  608.                    Topics[i-1] := Topics[i];
  609.                FillChar(Topics[MaxPicks],SizeOf(Topics[MaxPicks]),0);
  610.                Dec(MaxPicks);
  611.                For i := 1 to MaxPicks do
  612.                    ChangeTopic(i,Copy(Topics[i].Name,Pos('.',Topics[i].Name)+2,
  613.                             Length(Topics[i].Name)-Pos('.',Topics[i].Name)+2),False);
  614.           End;
  615.           If TopicNum > MaxPicks then
  616.              Topics[MaxPicks].Selected := WasSelected
  617.           Else
  618.              Topics[TopicNum].Selected := WasSelected;
  619.  
  620.           ActivateWrite;
  621.           For i := 1 to MaxPicks do
  622.               Redraw(i);
  623.           DeActivateWrite;
  624.      End;
  625. End;
  626.  
  627. Procedure PopWindow.SwitchTopics(Topic1, Topic2 : Byte);
  628. { ***************************************************************************
  629.    Swith topic1 and topic2, redrawing the menu
  630. *************************************************************************** }
  631. Var i      : Byte;
  632.     TTopic : TopicRec;
  633.  
  634. Begin
  635.      If (Topic1 <= MaxPicks) and (Topic2 <= MaxPicks)
  636.         and (Topic1 > 0) and (Topic2 > 0) then
  637.      Begin
  638.           TTopic := Topics[Topic1];
  639.           Topics[Topic1] := Topics[Topic2];
  640.           Topics[Topic2] := TTopic;
  641.  
  642.           ActivateWrite;
  643.           For i := 1 to MaxPicks do
  644.               Redraw(i);
  645.           DeActivateWrite;
  646.      End;
  647. End;
  648.  
  649.  
  650.  
  651. Procedure PopWindow.ScrollWindow(XT,YT,XB,YB:Byte);
  652. { ***************************************************************************
  653.    This procedure will scroll the window within the region specified using the
  654.    arrow keys
  655. *************************************************************************** }
  656.  
  657. Var
  658.    Ch : Word;
  659.  
  660. Function CheckMove(Direction : Word) : Boolean;
  661. Begin
  662.      CheckMove := False;
  663.      Case Direction of
  664.           Left      : If (XTop-1 <= XT) then Exit;
  665.           Right     : If (XBottom+1 >= XB) then Exit;
  666.           Up        : If (YTop-1 <= YT) then Exit;
  667.           Down      : iF (YBottom+1 >= YB) then Exit;
  668.      End;
  669.      CheckMove := True;
  670. End;
  671.  
  672. Procedure MoveWin(Direction : Word);
  673. Begin
  674.      If CheckMove(Direction) then
  675.      Begin
  676.           Case Direction of
  677.                Left      : Begin
  678.                                 AdjustWindow(XTop-1,YTop,XBottom-1,YBottom);
  679.                                 Dec(XTop);
  680.                                 Dec(XBottom);
  681.                            End;
  682.                Right     : Begin
  683.                                 AdjustWindow(XTop+1,YTop,XBottom+1,YBottom);
  684.                                 Inc(XTop);
  685.                                 Inc(XBottom);
  686.                            End;
  687.                Up        : Begin
  688.                                 AdjustWindow(XTop,YTop-1,XBottom,YBottom-1);
  689.                                 Dec(YTop);
  690.                                 Dec(YBottom);
  691.                            End;
  692.                Down      : Begin
  693.                                 AdjustWindow(XTop,YTop+1,XBottom,YBottom+1);
  694.                                 Inc(YTop);
  695.                                 Inc(YBottom);
  696.                            End;
  697.           End;
  698.      End;
  699. End;
  700.  
  701. Begin
  702.      Repeat
  703.            Ch := ReadKeyWord;
  704.            Case Ch of
  705.                 Left,Right,
  706.                 Up,Down     : MoveWin(Ch);
  707.            End;
  708.      Until (Ch = Enter) or (Ch = Esc);
  709. End;
  710.  
  711. Procedure PopWindow.Draw;
  712. { ***************************************************************************
  713.     Draw the menu
  714. *************************************************************************** }
  715. Var i : Byte;
  716. Begin
  717.      If AdjustMenu then
  718.      Begin
  719.      End;
  720.      CommandWindow.Draw;
  721.      ActivateWrite;
  722.      If (Headers > 0) then
  723.         fFastWrite(Center(Header1,(XBottom-XTop)),1,1,ColorMono(HeaderColor,HeaderMono));
  724.      If (Headers > 1) then
  725.         fFastWrite(Center(Header2,(XBottom-XTop)),2,1,ColorMono(HeaderColor,HeaderMono));
  726.      For i := 1 to MaxPicks do
  727.          Redraw(i);
  728.      DeActivateWrite;
  729. End;
  730.  
  731.  
  732. Procedure PopWindow.Process;
  733. { ***************************************************************************
  734.     Process all menu commands
  735. *************************************************************************** }
  736.  
  737. Var TChar    : Char;
  738.     Tsel     : Byte;
  739.     Finished : Boolean;
  740.  
  741. Procedure MoveBar(Old,New : Byte);
  742. Begin
  743.      Topics[Old].Selected := False;
  744.      Topics[New].Selected := True;
  745.      ActivateWrite;
  746.      ReDraw(Old);
  747.      Redraw(New);
  748.      DeActivateWrite;
  749.      Choice := New;
  750. End;
  751.  
  752. {$IFDEF UseMouse}
  753. Function CheckMouseMove :  Boolean;
  754. Var MX,MY : Byte;
  755.     Line  : Byte;
  756.  
  757. Begin
  758.      CheckMouseMove := False;
  759.      MX := MouseWhereXAbs;
  760.      MY := MouseWhereYAbs;
  761.      If (MX >= XTop) and (MX <= XBottom) and (MY >= YTop) and (MY <= YBottom) then
  762.      Begin
  763.           Line := MY - YTop +1;
  764.           If (Line >= 1) and (Line <= MaxPicks) then
  765.           Begin
  766.                If (Not ppOptionsAreOn(ppStick)) then
  767.                Begin
  768.                     MoveBar(Choice,Line);
  769.                     CheckMouseMove := True;
  770.                End
  771.                Else
  772.                Begin
  773.                     If Line = Choice then
  774.                        CheckMouseMove := True
  775.                     Else
  776.                        MoveBar(Choice,Line);
  777.                End;
  778.           End;
  779.      End;
  780. End;
  781. {$ENDIF}
  782.  
  783.  
  784.  
  785. Begin
  786.      HiddenCursor;
  787. {$IFDEF UseMouse}
  788.      If PopCommands.MouseEnabled then
  789.         ShowMouse;
  790. {$ENDIF}
  791.      Finished := False;
  792.      Repeat
  793.            GetNextCommand;
  794.            Case GetLastCommand of
  795.                 ccUp           : Begin
  796.                                       If (Choice = 1) then
  797.                                       Begin
  798.                                            If (Not ppOptionsAreOn(ppStick)) then
  799.                                               MoveBar(Choice,MaxPicks);
  800.                                       End
  801.                                       Else
  802.                                          MoveBar(Choice,Choice-1);
  803.                                  End;
  804.                 ccDown         : Begin
  805.                                       If (Choice = MaxPicks) then
  806.                                       Begin
  807.                                            If (Not ppOptionsAreOn(ppStick)) then
  808.                                               MoveBar(MaxPicks,1);
  809.                                       End
  810.                                       Else
  811.                                          MoveBar(Choice,Choice+1);
  812.                                  End;
  813. {$IFDEF UseMouse}
  814.                 ccMouseSel     : Begin
  815.                                       If PopCommands.MouseEnabled then
  816.                                          Finished := CheckMouseMove;
  817.                                  End;
  818. {$ENDIF}
  819.                 ccPageUp       : MoveBar(Choice,1);
  820.                 ccPageDn       : MoveBar(Choice,MaxPicks);
  821.                 ccSelect       : Finished := True;
  822.                 ccScrollWin    : ScrollWindow(1,1,80,24);
  823.                 ccChar         : Begin
  824.                                       TChar := UpCase(Char(Lo(GetLastKey)));
  825.                                       If (TChar in AllowSet[DefaultSet]) then
  826.                                       Begin
  827.                                          If (DefaultSet = 1) then
  828.                                             TSel := Ord(TChar) - Ord('1') + 1
  829.                                          Else
  830.                                             TSel := Ord(TChar) - Ord('A') + 1;
  831.                                          If (TSel <= MaxPicks) then
  832.                                          Begin
  833.                                               MoveBar(Choice,TSel);
  834.                                               If (not ppOptionsAreOn(ppStick)) then
  835.                                                  Finished := True
  836.                                               Else
  837.                                                  Finished := False;
  838.                                          End;
  839.                                      End;
  840.                                  End;
  841.                 ccQuit         : If ppOptionsAreOn(ppAllowEsc) then
  842.                                     Finished := True
  843.                                  Else
  844.                                  Begin
  845.                                       Finished := False;
  846.                                       MoveBar(Choice,MaxPicks);
  847.                                  End;
  848.            End;
  849.     Until (Finished) or (GetLastCommand = ccError);
  850.     NormalCursor;
  851. End;
  852.  
  853. Begin
  854.      PopCommands.Init(@KeySet,KeyMax);
  855. End.
  856.  
  857.  
  858.  
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  
  866.  
  867.  
  868.